COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002		SUBROUTINE WRTPAG
C00017 ENDMK
C⊗;
	SUBROUTINE WRTPAG
	DATA SLSP/12.0/
	COMMON /FIN/JBAR,NPX,REND,KPX,KREAD,JEND,JSLUR,JSL2,NAMZ
	1,LC,LPG,MPG,CLEF,SIG,LB,SPG,MTR1,MTR2 
	1 /SF/KL,RT,KP,SIZE,NAMX,EXT /IPG/IPG
	1 ,JPG,BRACK(0/7),RSTNUM(8),RPSZ(8),RHGT(8),RCLEF(0/7) 
	1 /RSP/KNM(10),ENDLN,N,NAME,NMPG,T /KBAR/KBAR(515)
 	1 /RCLF/KK,CL,KW,ITEM,RSTAFF,SN,YN,RNAM,RNAM2,ITR
	COMMON RS,JA,CLEFQ,AA,RQ(16),KQ,NQ,JQ,JJQ,KBQ,NAQ
	COMMON/STF/RSTFAC(0/7),RSTJ2 /IVV/IV(1) /KNUM/KNUM
	COMMON /POSI/STFF(0/7),JJ2,JPQ /LLL/L,LL,I,RXQ
	1/PX/KPN(1) /Q/Q(1) /PTR/KWDS(1) /XRN/RN(1) /NBAR/NBAR(1)
	1/BRJ/JTOT,TURN,NB,DSK,PGLNTH
	DIMENSION ENDSTF(450),KPTR(50)
C  ENDSTF AND ENDPTR FOR CARRYING STUFF FROM ONE LINE TO THE NEXT.
	EQUIVALENCE (RQ(2),R4),(R5,RQ(3)),(R7,RQ(5))
	1,(R8,RQ(6)),(LCNT,IV(45)),(NDPY,IV(46)),(ENDSTF,KBAR(4))
	DATA VERT/0.045/
C VERT IS BASIC VERTICLE UNIT SIZE IN INCHES
	IF(MPG.NE.0)GO TO 4
	DO 1 K=1,100
1	IF(NBAR(K).EQ.0)GO TO 3
3	MPG=K-1
C SETS NUMB. OF LINES ON FIRST PAGE
4	IF(SPG.EQ.0)SPG=PGLNTH/MPG
	RS=SIZE*17.5
	HX=0
CC	RA=(RSTJ2*SIZE)/RPSZ(1)
	RA=RPSZ(JPG)
C SAVE SIZE OF TOP STAFF FOR LATER
	DO 141 K=1,JPG
	RB=RSTNUM(K)
C  ADJUSTS DIST. BETWEEN STAVES DEPENDING ON SIZE FACTOR.
	RHGT(K)=RHGT(K)+RB*(RS-17.5)
CC	RPSZ(K)=RPSZ(K)*RA
141	RPSZ(K)=RPSZ(K)*SIZE
CC141	HX=HX+(RHGT(K)+17.5)*RPSZ(K)*RT
CZZ	HX=(17.5*RSTNUM(JPG)+17.5)*VERT
	HX=(17.5*RSTNUM(JPG)+17.5+RHGT(JPG)*RA)*VERT
C HX=TOTAL HEIGHT IN INCHES. THIS ASSUMES RSTNUM(JPG) IS HIGHEST STAFF NUM.
C ALSO ASSUMES HIGHEST STAFF NUM. IS REALLY ABOVE ALL OTHERS.
143	IF(HX.LE.SPG)GO TO 140
	HX=SPG/HX
C GET  THE FACTOR FOR SPACE BETWEEN STAVES
CZZ	DO 142 K=1,LPG
CZZ	RA=17.5*RSTNUM(K)
CZZ142	RHGT(K)=RA*HX-RA
	RA=1/HX
	DO 142 K=1,JPG
	SP=RHGT(K)
	IF(SP)GO TO 1142
C MULT +S * <1, -S * >1  TO REDUCE SIZE
	SP=SP*HX
	GO TO 142
1142	SP=SP*RA
142	RHGT(K)=SP
CC142	RHGT(K)=(RA+RHGT(K))*HX-RA
140	NPG=1
	NMPG='PAGEA'
	HORZ=96.
	IF(KNUM.GT.0)KNUM=KNUM-1
C FOR PAGE NUMS.
	IF(MOD(KNUM,2).NE.0)HORZ=-HORZ
	RNUM=0.+KNUM
	LB=0
	ITR=LL
C TRANSPOSE IS IN LL
	RA=0
	JEND=-1
	METR=1000
	CLEF=-99
	JSLUR=0
	LC=1
	KREAD=128
	SIG=CLEF
	HX=2
	KQ=1
	KPX=1
	CALL FILOUT
C NAMQ AND NPG ARE SET IN FILOUT  
	SP=2.45
C  DEFAULT VERT. SPACE UNITS
	ENDSTF(1)=0
	IF(N.EQ.0)GO TO 100
C  SPACED OUT DEPENDING ON NUM OF LINES
	HX=N
	SP=SP+(HX-2.)*.11

100	CALL FILEIN

320	CALL STAVES
CC	IF(IPG)GO TO 3000
	IF(NPG.NE.1)GO TO 3000
	RT=RSTNUM(JPG)
	RS=100.+HORZ
	HORZ=-HORZ
	RNUM=RNUM+1
C ADDS PAGE NUMBER.
	CALL STAFF(4.,10.,RS,28.,RNUM,1.1,0,0,0,0,0,0)
3000	IF(ITR.NE.0)CALL TRNSP
	JPQ=KL

	NA=0
	KPT=1
	ENDSTF(1)=0
C  LOOP STARTS HERE *******
131	NA=NA+1
	KWDS(KP)=JPQ
	KP=KP+1
	R=CODEN(KPN,NA,Q,JK)
	RR=Q(JK+6)
	RS=Q(JK)
	IF(R.NE.5)GO TO 935
	R8=-1
	IF(RS.GE.6)R8=Q(JK+8)
	IF(RR)GO TO 735
	IF(RR.LE.Q(JK+3))RR=202.
	GO TO 235
C CATCHES SLURS, TRILLS, 8VA, LINES THAT GO PAST END OF LINE.
935	IF(R.EQ.7)GO TO 835
	IF(R.NE.44)GO TO 35
	R=R/11.
	Q(JK+1)=R
C  INFOR FOR P9 AND L10 OF DASHES AND WIGGLES NOT KEPT YET!!!!!!!
	IF(RR.LT.Q(JK+3))GO TO 30
C  NEEDED WHEN DATA ON LINE HAS BEEN EXPANDED, NOT CONTRACTED.
835	R8=0
	R7=0
	IF(RS.GE.6)R8=Q(JK+8)
235	IF(RR.LT.199.)GO TO 30
C  P1,P2,P3,P4,P5,P6,P7,P8  ARE SAVED.
	RR=-1
735	IF(RS.GE.5)R7=Q(JK+7)
	ENDSTF(KPT)=6
	ENDSTF(KPT+1)=R
	C=Q(JK+2)
	ENDSTF(KPT+2)=C
	ENDSTF(KPT+3)=1
	ENDSTF(KPT+4)=Q(JK+4)
	ENDSTF(KPT+5)=Q(JK+5)
	ENDSTF(KPT+7)=R7
	ENDSTF(KPT+8)=R8
 	ENDSTF(KPT+6)=RR

236	KPT=KPT+13
	ENDSTF(KPT)=0
	Q(JK+6)=202
	GO TO 30
C*************
35	IF(R.NE.2)GO TO 36
	IF(RS.LT.6.)GO TO 30

	RR=RIGHT(NA,-1,JK)
	Q(JK+3)=RR-1.6*RSTJ2+(RIGHT(NA,1,JK)-RR)/2.
C  FUNCTION 'RIGHT' FINDS ITEMS TO LFT AND RT OF REST FOR CENTERING.
C CENTERS WHOLE REST
	GO TO 30
36	IF(R.NE.3)GO TO 34
	CLEF=CLEFN(Q,JK)
	LL=Q(JK+2)
C GETS CLEF FOR PAGE LAYOUT
	RCLEF(LL)=CLEF
	GO TO 30
34	IF(R.NE.17)GO TO 37
	SIG=Q(JK+5)
	IF(ABS(SIG).GT.100.)SIG=-99
C  DO NOT REPEAT KSIG MADE UP OF NATURALS.
CXX	IF(Q(JK).GT.3)SIG=SIG+Q(JK+6)*100.
CXX  CLEF # IN P6 WITH KEY SIGS.
C  NEXT CHANGES CODE NUM BACK TO ORIGINAL
37	IF(R.LT.33)GO TO 130
38	Q(JK+1)=R/11.
	GO TO 30
130	IF(Q(JK+3).LT.199)GO TO 30
	IF(R.NE.18)GO TO 30
	KKK=K+1
	R3=9
	IF(SIG.NE.-99)R3=14
	KK=JK
435	LL=KPN(KKK)
C  WDCNT,P1,P2,P3,P4,P5,P6,P7,P8
	ENDSTF(KPT)=Q(KK)
	ENDSTF(KPT+1)=R
	ENDSTF(KPT+2)=Q(KK+2)
	ENDSTF(KPT+3)=R3
	DO 535 JJ2=4,12
535	ENDSTF(KPT+JJ2)=Q(KK+JJ2)
	KPT=KPT+13
	ENDSTF(KPT)=0

	RS=Q(LL+1)
	IF(RS.LE.4)GO TO 30
	R4=Q(LL+2)
C  SAVE THE STAFF NUM. IN R4
	IF(RS.NE.18)GO TO 7011
335	R3=R3+6
	KK=LL
	KKK=KKK+1
	GO TO 435
7011	RS=CODEN(KPN,KKK+1,Q,LL)
	IF(RS.LE.4)GO TO 30
	IF(Q(LL+2).NE.R4)GO TO 30
	IF(RS.EQ.18)GO TO 335
30	JPQ=KPN(NA+1)-KPN(NA)+JPQ
	IF(NA.LT.I)GO TO 131
C  END OF LOOP ****************

	CALL PSHFT(I)
	RS=-1
C -1 FOR ALL STAVES AT ONCE IN GETPTS.
CCC	RS=RT
	LL='J'
	R4=0
	R5=200
	NA=L
	L=KP-1 
	CALL PTMOVE(RN,KWDS(1))

C  START LAST LOOP *******
	DO 47 JJ2=1,KP
	LL=KWDS(JJ2)
	AA=RN(LL+1)
	IF(AA.NE.10.AND.AA.NE.16)GO TO 1047
CN	IF(AA.NE.10.AND.AA.NE.16)GO TO 347
	DO 147 NN=JJ2+1,KP
	MM=KWDS(NN)
	IF(RN(MM+1).NE.16)GO TO 147
C  FOUND THE NEXT TEXT AFTER TEXT OR NUMB.
	IF(RN(MM).EQ.8)GO TO 47
C  JUMP IF POS. IS ALREADY TAKEN CARE OF.
	IF(AA.EQ.10)GO TO 247
C NEXT FOR TEXT FOLLOWING TEXT
	IF(ABS(RN(MM+4)-RN(LL+4)).GE.4)GO TO 47
C JUMP IF ON DIFF. VERT. PLANE.
	AA=(RN(LL+9)+4.)*RSTJ2*RN(LL+5)+RN(LL+3)
C  SETS MINIMUM SPACE.
	IF(RN(MM+3).LT.AA)RN(MM+3)=AA
	GO TO 47
247	IF(ABS(RN(MM+4)-RN(LL+4)).GT.6)GO TO 47
C  CHECKS VERT. POS.
	AA=RN(LL+4)+7
	IF(RN(MM+4)-AA.LT.0)RN(MM+4)=AA
C  MOVE WORD TO RIGHT OF NUMBER IF IT WAS TOO CLOSE
	GO TO 47
147	CONTINUE
	GO TO 47
1047	IF(AA.NE.6)GO TO 47
	IF(RN(LL).LT.7)GO TO 47
	IF(RN(LL+9).GT.200.)RN(LL+9)=0
C ********** FIX THIS IN GETPTS, MOVER.  IT SHOULDN'T MOVE P9 ALWAYS.
47	CONTINUE

2	KWDS(KP)=JPQ
CP	J=1
	IF(KP.GE.300.OR.JPQ.GE.2500)TYPE 20,KP,JPQ
	JJ2=KP+1
C  WRITES 1 EXTRA WORD
CP	JPQ=KB

	DO 12 K=1,KP
CC	N=KWDS(K)
CC	R=RN(N+1)
	R=CODEN(KWDS,K,RN,N)
	IF(R.LE.2)GO TO 22
C  ONCE IT FINDS A REST OR NOTE IT MUST HAVE GONE TOO FAR.
	IF(R.GT.7)GO TO 12
 	IF(R.EQ.5)GO TO 52
	IF(R.NE.4)GO TO 62
	IF(RN(N).GE.4)GO TO 52
62	IF(R.NE.7)GO TO 12
52	A=RN(N+6)
C J HAS NOTE COUNT TO FIND POS OF RIGHT END OF SLUR.
	IF(A.GE.0)GO TO 12
	J=A
	IF(J.EQ.0)J=-1
	B=RN(N+2)
C  B=STAFF NUM.
	JJ=0

	DO 32 KK=K+1,KP
CC	NN=KWDS(KK)
CC	A=RN(NN+1)
	A=CODEN(KWDS,KK,RN,NN)
	IF(A.NE.1)GO TO 32
	IF(B.NE.RN(NN+2))GO TO 32
	D=RN(NN+3)
	JJ=JJ-1
	IF(J.NE.JJ)GO TO 42
	RN(N+6)=D+(D-A)*(RN(N+6)-J)
C FOUND NOTE FOR POSITION.
	GO TO 12
42	A=D
32	CONTINUE
12	CONTINUE
	
22	CALL PUTEXT(NAMX,EXT)
	LCNT=0
	NDPY=0
	RSTFAC(96)=0
C  MUST BE 0 IN MS TO MAKE DISPLAY
	CALL EXTOUT(RSTFAC,128)
	CALL EXTOUT(KWDS,JJ2)
	CALL EXTOUT(RN,JPQ)
	TYPE 101,NAMX,EXT
	NAMX=NAMX+2
CC	IF(IPG)GO TO 6011
	NPG=NPG+1
	IF(NBAR(LC).NE.0)GO TO 220
	KK=LC+1
	IF(NBAR(KK).EQ.0)GO TO 220
CHECK FOR ZEROS WHICH ARE PAGE MARKS.
	LC=LC+1
221	KK=KK+1
	IF(NBAR(KK).NE.0)GO TO 221
C  FIND NEW MPG
	MPG=KK-LC
	NPG=1000
	SPG=10./MPG
	JEND=0
C RESET ABOVE
220	IF(NPG.LE.MPG)GO TO 6011
	NPG=1
C RESET, UPDATE FILENAMES
	NAMX=NAMZ+256
	NAMZ=NAMX
6011	NAMQ=NAMX
	CALL FINEXT
	GO TO 100
C IPG=1  = GO BACK TO TRONLY INSTEAD
101	FORMAT(1XA5,'.',A3)
20	FORMAT(' TOO MUCH DATA!!! ',I3,'/300',I5,'/2500')
	END